home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacMETH 3.2.1 / Coroutines / Coroutines.MOD < prev    next >
Encoding:
Modula Implementation  |  1994-04-20  |  4.0 KB  |  175 lines  |  [TEXT/MEDT]
  1. IMPLEMENTATION MODULE Coroutines;
  2.   (*
  3.         Implementation and Revisions:
  4.         ============================
  5.  
  6.         Author  Date        Description
  7.         ------  ----        -----------
  8.  
  9.         JT      7/4/94    First implementation (MacMETH_V3.2)
  10.  
  11.   *)
  12.  
  13.  
  14.   FROM Thread IMPORT
  15.     ThreadID,
  16.     OSErr,
  17.     kCooperativeThread,
  18.     kPreemptiveThread,
  19.     kUsePremadeThread, kNewSuspend,
  20.     kCurrentThreadID,
  21.     kStoppedThreadState, kReadyThreadState, kNoThreadID,
  22.     ThreadCurrentStackSpace,
  23.     GetCurrentThread, YieldToThread,
  24.     GetFreeThreadCount, CreateThreadPool,
  25.     NewThread, DisposeThread,
  26.     SetThreadState,
  27.     ThreadBeginCritical, ThreadEndCritical,
  28.     ThreadsAvailable;
  29.  
  30.   FROM SYSTEM IMPORT VAL;
  31.  
  32.   CONST
  33.     POOLSize = 5;      (* How many Process-Stacks will be allocated at one time *)
  34.     OVERHead = 2024D;  (* How many bytes will be added to the requested workspace *)
  35.     
  36.   TYPE
  37.     Coroutine = ThreadID;
  38.     Process   = ThreadID;
  39.   
  40.   VAR
  41.     transferErr : OSErr;
  42.  
  43.   PROCEDURE StartThread(l : LONGINT ) : LONGINT;
  44.     VAR
  45.       p   : PROC;
  46.       err : OSErr;
  47.   BEGIN
  48.     p := VAL(PROC, l);
  49.     p;
  50.     err := DisposeThread(kCurrentThreadID, 0D, TRUE);
  51.     RETURN 0D;
  52.   END StartThread;
  53.   
  54.   PROCEDURE NewCoroutine(p: PROC; n: LONGINT; VAR cID: Coroutine);
  55.     VAR
  56.       err  : OSErr;
  57.       free : INTEGER;
  58.   BEGIN
  59.     err := GetFreeThreadCount(kCooperativeThread, free);
  60.     IF err <> 0 THEN HALT; RETURN END;
  61.     IF free = 0 THEN
  62.       err := CreateThreadPool(kCooperativeThread, POOLSize, n + OVERHead);
  63.       IF err <> 0 THEN HALT; RETURN END;
  64.     END(*IF*);
  65.     err := NewThread(kCooperativeThread,
  66.                      StartThread,
  67.                      VAL(LONGINT, p),
  68.                      n + OVERHead,
  69.                      kUsePremadeThread,
  70.                      NIL,
  71.                      cID);
  72.     IF err <> 0 THEN HALT; RETURN END;
  73.   END NewCoroutine;
  74.  
  75.  
  76.  
  77.   PROCEDURE Transfer(VAR fromID, toID: Coroutine);
  78.   BEGIN
  79.     transferErr := GetCurrentThread(fromID);
  80.     transferErr := YieldToThread(toID);
  81.   END Transfer;
  82.  
  83.   PROCEDURE FreeCoroutineWorkspace(cID : Coroutine) : LONGINT;
  84.     VAR
  85.       freeStack : LONGINT;
  86.       err       : OSErr;
  87.   BEGIN
  88.     err := ThreadCurrentStackSpace(cID, freeStack);
  89.     IF err <> 0 THEN
  90.       RETURN 0D;
  91.     ELSE
  92.       RETURN freeStack;
  93.     END(*IF*);
  94.   END FreeCoroutineWorkspace;
  95.  
  96.   PROCEDURE MyCoroutineID() : Coroutine;
  97.     VAR
  98.       cID : Coroutine;
  99.       err : OSErr;
  100.   BEGIN
  101.     err := GetCurrentThread(cID);
  102.     RETURN cID;
  103.   END MyCoroutineID;
  104.  
  105.  
  106.  
  107.   PROCEDURE NewProcess(p: PROC; n: LONGINT; VAR pID: Process);
  108.     VAR
  109.       err  : OSErr;
  110.       free : INTEGER;
  111.   BEGIN
  112.     err := GetFreeThreadCount(kPreemptiveThread, free);
  113.     IF err <> 0 THEN HALT; RETURN END;
  114.     IF free = 0 THEN
  115.       err := CreateThreadPool(kPreemptiveThread, POOLSize, n + OVERHead);
  116.       IF err <> 0 THEN HALT; RETURN END;
  117.     END(*IF*);
  118.     err := NewThread(kPreemptiveThread,
  119.                      StartThread,
  120.                      VAL(LONGINT, p),
  121.                      n + OVERHead,
  122.                      kNewSuspend + kUsePremadeThread,
  123.                      NIL,
  124.                      pID);
  125.     IF err <> 0 THEN HALT; RETURN END;
  126.   END NewProcess;
  127.  
  128.  
  129.     (* the process is started in suspended State *)
  130.  
  131.   PROCEDURE ResumeProcess(pID: Process);
  132.     
  133.   BEGIN
  134.     transferErr := SetThreadState(pID, kReadyThreadState, kNoThreadID)
  135.   END ResumeProcess;
  136.  
  137.   
  138.   PROCEDURE SuspendProcess(pID: Process);
  139.     
  140.   BEGIN
  141.     transferErr := SetThreadState(pID, kStoppedThreadState, kNoThreadID)
  142.   END SuspendProcess;
  143.  
  144.   
  145.   PROCEDURE MyProcessID() : Process;
  146.     VAR
  147.       pID : Coroutine;
  148.       err : OSErr;
  149.   BEGIN
  150.     err := GetCurrentThread(pID);
  151.     RETURN pID;
  152.   END MyProcessID;
  153.  
  154.  
  155.   PROCEDURE BEGINCriticalSection();
  156.     VAR
  157.       err : OSErr;
  158.   BEGIN
  159.     err := ThreadBeginCritical();
  160.   END BEGINCriticalSection;
  161.  
  162.  
  163.   PROCEDURE ENDCriticalSection();
  164.     VAR
  165.       err : OSErr;
  166.   BEGIN
  167.     err := ThreadEndCritical();
  168.   END ENDCriticalSection;
  169.  
  170.  
  171.  
  172. BEGIN
  173.   IF NOT(ThreadsAvailable()) THEN HALT; END; (* Thread Package not available *)
  174. END Coroutines.